home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / tcl-mode.el.z / tcl-mode.el
Encoding:
Text File  |  1998-10-28  |  19.2 KB  |  665 lines
  1. ;;; tcl-mode.el --- a major-mode for editing tcl/tk scripts
  2.  
  3. ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Gregor Schmid <schmid@fb3-s7.math.tu-berlin.de>
  6. ;; Keywords: languages, processes, tools
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; Special Thanks to Simon Marshall <simonm@mail.esrin.esa.it> for
  28. ;; font-lock patches.
  29.  
  30. ;; This file was written with emacs using Jamie Lokier's folding mode
  31. ;; That's what the funny ;;{{{ marks are there for
  32.  
  33. ;;{{{ Usage
  34.  
  35. ;; Tcl-mode supports c-mode style formatting and sending of
  36. ;; lines/regions/files to a tcl interpreter. An interpreter (see
  37. ;; variable `tcl-default-application') will be started if you try to
  38. ;; send some code and none is running. You can use the process-buffer
  39. ;; (named after the application you chose) as if it were an
  40. ;; interactive shell. See the documentation for `comint.el' for
  41. ;; details.
  42.  
  43. ;;}}}
  44. ;;{{{ Key-bindings
  45.  
  46. ;; To see all the keybindings for folding mode, look at `tcl-setup-keymap'
  47. ;; or start `tcl-mode' and type `\C-h m'.
  48. ;; The keybindings may seem strange, since I prefer to use them with
  49. ;; tcl-prefix-key set to nil, but since those keybindings are already used
  50. ;; the default for `tcl-prefix-key' is `\C-c', which is the conventional
  51. ;; prefix for major-mode commands.
  52.  
  53. ;; You can customise the keybindings either by setting `tcl-prefix-key'
  54. ;; or by putting the following in your .emacs
  55. ;;     (setq tcl-mode-map (make-sparse-keymap))
  56. ;; and
  57. ;;     (define-key tcl-mode-map <your-key> <function>)
  58. ;; for all the functions you need.
  59.  
  60. ;;}}}
  61. ;;{{{ Variables
  62.  
  63. ;; You may want to customize the following variables:
  64. ;;     tcl-indent-level
  65. ;;     tcl-always-show
  66. ;;    tcl-mode-map
  67. ;;    tcl-prefix-key
  68. ;;    tcl-mode-hook
  69. ;;     tcl-default-application
  70. ;;     tcl-default-command-switches
  71.  
  72. ;;}}}
  73.  
  74. ;;; Code:
  75.  
  76. ;; We need that !
  77. (require 'comint)
  78.  
  79. ;;{{{ variables
  80.  
  81. (defvar tcl-default-application "wish"
  82.   "Default tcl/tk application to run in tcl subprocess.")
  83.  
  84. (defvar tcl-default-command-switches nil
  85.   "Command switches for `tcl-default-application'.
  86. Should be a list of strings.")
  87.  
  88. (defvar tcl-process nil
  89.   "The active tcl subprocess corresponding to current buffer.")
  90.  
  91. (defvar tcl-process-buffer nil
  92.   "Buffer used for communication with tcl subprocess for current buffer.")
  93.  
  94. (defvar tcl-always-show t
  95.   "*Non-nil means display tcl-process-buffer after sending a command.")
  96.  
  97. (defvar tcl-mode-map nil
  98.   "Keymap used with tcl mode.")
  99.  
  100. (defvar tcl-prefix-key "\C-c"
  101.   "Prefix for all tcl-mode commands.")
  102.  
  103. (defvar tcl-mode-hook nil
  104.   "Hooks called when tcl mode fires up.")
  105.  
  106. (defvar tcl-region-start (make-marker)
  107.   "Start of special region for tcl communication.")
  108.  
  109. (defvar tcl-region-end (make-marker)
  110.   "End of special region for tcl communication.")
  111.  
  112. (defvar tcl-indent-level 4
  113.   "Amount by which tcl subexpressions are indented.")
  114.  
  115. (defvar tcl-default-eval "eval"
  116.   "Default command used when sending regions.")
  117.  
  118. (defvar tcl-mode-menu (make-sparse-keymap "Tcl-Mode")
  119.   "Keymap for tcl-mode's menu.")
  120.  
  121. (defvar tcl-font-lock-keywords
  122.   (eval-when-compile
  123.     (list
  124.      ;;
  125.      ;; Function name declarations.
  126.      '("\\<\\(itcl_class\\|method\\|proc\\)\\>[ \t]*\\(\\sw+\\)?"
  127.        (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
  128.      ;;
  129.      ;; Keywords.
  130. ;(make-regexp '("if" "then" "else" "elseif" "for" "foreach" "break"
  131. ;           "continue" "while" "eval" "case" "in" "switch" "default"
  132. ;           "exit" "error" "proc" "return" "uplevel" "constructor"
  133. ;           "destructor" "itcl_class" "loop" "for_array_keys"
  134. ;           "for_recursive_glob" "for_file"))
  135.      (concat "\\<\\("
  136.          "break\\|c\\(ase\\|on\\(structor\\|tinue\\)\\)\\|"
  137.          "de\\(fault\\|structor\\)\\|"
  138.          "e\\(lse\\(\\|if\\)\\|rror\\|val\\|xit\\)\\|"
  139.          "for\\(\\|_\\(array_keys\\|file\\|recursive_glob\\)\\|each\\)\\|"
  140.          "i\\([fn]\\|tcl_class\\)\\|loop\\|proc\\|return\\|switch\\|"
  141.          "then\\|uplevel\\|while"
  142.          "\\)\\>")
  143.      ;;
  144.      ;; Types.
  145. ;   (make-regexp '("global" "upvar" "inherit" "public" "protected" "common"))
  146.      (cons (concat "\\<\\(common\\|global\\|inherit\\|"
  147.            "p\\(rotected\\|ublic\\)\\|upvar\\)\\>")
  148.        'font-lock-type-face)
  149.      ))
  150.   "Default expressions to highlight in TCL modes.")
  151.  
  152. (defvar tcl-imenu-generic-expression
  153.   '((nil "^[ \t]*proc[ \t]+\\(\\(\\s_\\|\\sw\\)+\\)" 1))
  154.   "Imenu generic expression for tcl-mode.  See `imenu-generic-expression'.")
  155.  
  156.  
  157. ;;}}}
  158. ;;{{{ tcl-mode
  159.  
  160. ;;;###autoload
  161. (defun tcl-mode ()
  162.   "Major mode for editing tcl scripts.
  163. The following keys are bound:
  164. \\{tcl-mode-map}
  165. "
  166.   (interactive)
  167.   (let ((switches nil)
  168.     s)
  169.     (kill-all-local-variables)
  170.     (setq major-mode 'tcl-mode)
  171.     (setq mode-name "TCL")
  172.     (set (make-local-variable 'tcl-process) nil)
  173.     (set (make-local-variable 'tcl-process-buffer) nil)
  174.     (make-local-variable 'tcl-default-command-switches)
  175.     (set (make-local-variable 'indent-line-function) 'tcl-indent-line)
  176.     (set (make-local-variable 'comment-start) "# ")
  177.     (set (make-local-variable 'comment-start-skip) "# *")
  178.     (set (make-local-variable 'font-lock-defaults)
  179.      '(tcl-font-lock-keywords nil nil ((?_ . "w"))))
  180.     (set (make-local-variable 'imenu-generic-expression)
  181.      tcl-imenu-generic-expression)
  182.     (make-local-variable 'tcl-default-eval)
  183.     (or tcl-mode-map
  184.     (tcl-setup-keymap))
  185.     (use-local-map tcl-mode-map)
  186.     (set-syntax-table (copy-syntax-table))
  187.     (modify-syntax-entry ?# "<")
  188.     (modify-syntax-entry ?\n ">")
  189.     ;; look for a #!.../wish -f line at bob
  190.     (save-excursion
  191.       (goto-char (point-min))
  192.       (if (looking-at "#![ \t]*\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)-f")
  193.       (progn
  194.         (set (make-local-variable 'tcl-default-application)
  195.          (buffer-substring (match-beginning 1)
  196.                    (match-end 1)))
  197.         (if (match-beginning 2)
  198.         (progn
  199.           (goto-char (match-beginning 2))
  200.           (set (make-local-variable 'tcl-default-command-switches) nil)
  201.           (while (< (point) (match-end 2))
  202.             (setq s (read (current-buffer)))
  203.             (if (<= (point) (match-end 2))
  204.             (setq tcl-default-command-switches
  205.                   (append tcl-default-command-switches
  206.                       (list (prin1-to-string s)))))))))
  207.     ;; if this fails, look for the #!/bin/csh ... exec hack
  208.     (while (eq (following-char) ?#)
  209.       (forward-line 1))
  210.     (or (bobp)
  211.         (forward-char -1))
  212.     (if (eq (preceding-char) ?\\)
  213.         (progn
  214.           (forward-char 1)
  215.           (if (looking-at "exec[ \t]+\\([^ \t]*\\)[ \t]\\(.*[ \t]\\)*-f")
  216.           (progn
  217.             (set (make-local-variable 'tcl-default-application)
  218.              (buffer-substring (match-beginning 1)
  219.                        (match-end 1)))
  220.             (if (match-beginning 2)
  221.             (progn
  222.               (goto-char (match-beginning 2))
  223.               (set (make-local-variable
  224.                 'tcl-default-command-switches)
  225.                    nil)
  226.               (while (< (point) (match-end 2))
  227.                 (setq s (read (current-buffer)))
  228.                 (if (<= (point) (match-end 2))
  229.                 (setq tcl-default-command-switches
  230.                       (append tcl-default-command-switches
  231.                           (list (prin1-to-string s)))))))))
  232.         )))))
  233.     (run-hooks 'tcl-mode-hook)))
  234.  
  235. ;;}}}
  236. ;;{{{ tcl-setup-keymap
  237.  
  238. (defun tcl-setup-keymap ()
  239.   "Set up keymap for tcl mode.
  240. If the variable `tcl-prefix-key' is nil, the bindings go directly
  241. to `tcl-mode-map', otherwise they are prefixed with `tcl-prefix-key'."
  242.   (setq tcl-mode-map (make-sparse-keymap))
  243.   (define-key tcl-mode-map [menu-bar tcl-mode]
  244.     (cons "Tcl-Mode" tcl-mode-menu))
  245.   (let ((map (if tcl-prefix-key
  246.          (make-sparse-keymap)
  247.            tcl-mode-map)))
  248.   ;; indentation
  249.   (define-key tcl-mode-map [?}] 'tcl-electric-brace)
  250.   ;; communication
  251.   (define-key map "\M-e" 'tcl-send-current-line)
  252.   (define-key map "\M-r" 'tcl-send-region)
  253.   (define-key map "\M-w" 'tcl-send-proc)
  254.   (define-key map "\M-a" 'tcl-send-buffer)
  255.   (define-key map "\M-q" 'tcl-kill-process)
  256.   (define-key map "\M-u" 'tcl-restart-with-whole-file)
  257.   (define-key map "\M-s" 'tcl-show-process-buffer)
  258.   (define-key map "\M-h" 'tcl-hide-process-buffer)
  259.   (define-key map "\M-i" 'tcl-get-error-info)
  260.   (define-key map "\M-[" 'tcl-beginning-of-proc)
  261.   (define-key map "\M-]" 'tcl-end-of-proc)
  262.   (define-key map "\C-\M-s" 'tcl-set-tcl-region-start)
  263.   (define-key map "\C-\M-e" 'tcl-set-tcl-region-end)
  264.   (define-key map "\C-\M-r" 'tcl-send-tcl-region)
  265.   (if tcl-prefix-key
  266.       (define-key tcl-mode-map tcl-prefix-key map))
  267.   ))
  268.  
  269. ;;}}}
  270. ;;{{{ indentation
  271.  
  272. ;;{{{ tcl-indent-line
  273.  
  274. (defun tcl-indent-line ()
  275.   "Indent current line as tcl code.
  276. Return the amount the indentation changed by."
  277.   (let ((indent (tcl-calculate-indentation nil))
  278.     beg shift-amt
  279.     (case-fold-search nil)
  280.     (pos (- (point-max) (point))))
  281.     (beginning-of-line)
  282.     (setq beg (point))
  283.     (skip-chars-forward " \t")
  284.     (save-excursion
  285.       (while (eq (following-char) ?})
  286.     (setq indent (max (- indent tcl-indent-level) 0))
  287.     (forward-char 1)
  288.     (if (looking-at "\\([ \t]*\\)}")
  289.         (progn
  290.           (delete-region (match-beginning 1) (match-end 1))
  291.           (insert-char ?  (1- tcl-indent-level))))))
  292.     (setq shift-amt (- indent (current-column)))
  293.     (if (zerop shift-amt)
  294.     (if (> (- (point-max) pos) (point))
  295.         (goto-char (- (point-max) pos)))
  296.       (delete-region beg (point))
  297.       (indent-to indent)
  298.       ;; If initial point was within line's indentation,
  299.       ;; position after the indentation.  Else stay at same point in text.
  300.       (if (> (- (point-max) pos) (point))
  301.       (goto-char (- (point-max) pos))))
  302.     shift-amt))
  303.  
  304. ;;}}}
  305. ;;{{{ tcl-calculate-indentation
  306.  
  307. (defun tcl-calculate-indentation (&optional parse-start)
  308.   "Return appropriate indentation for current line as tcl code.
  309. In usual case returns an integer: the column to indent to."
  310.   (let ((pos (point)))
  311.     (save-excursion
  312.       (if parse-start
  313.       (setq pos (goto-char parse-start)))
  314.       (beginning-of-line)
  315.       (if (bobp)
  316.       (current-indentation)
  317.     (forward-char -1)
  318.     (if (eq (preceding-char) ?\\)
  319.         (+ (current-indentation)
  320.            (progn
  321.          (beginning-of-line)
  322.          (if (bobp)
  323.              (* 2 tcl-indent-level)
  324.            (forward-char -1)
  325.            (if (not (eq (preceding-char) ?\\))
  326.                (* 2 tcl-indent-level)
  327.              0))))
  328.       (forward-char 1)
  329.       (if (re-search-backward
  330.            "\\(^[^ \t\n\r#]\\)\\|\\({\\s *[#\n]\\)\\|\\(}\\s *\n\\)"
  331.            nil  t)
  332.           (+ (- (current-indentation)
  333.             (if (save-excursion
  334.               (beginning-of-line)
  335.               (and (not (bobp))
  336.                    (progn
  337.                  (forward-char -1)
  338.                  (eq (preceding-char) ?\\))))
  339.             (* 2 tcl-indent-level)
  340.               0))
  341.          (if (eq (following-char) ?{)
  342.              tcl-indent-level
  343.            0))
  344.         (goto-char pos)
  345.         (beginning-of-line)
  346.         (forward-line -1)
  347.         (current-indentation)))))))
  348.  
  349. ;;}}}
  350. ;;{{{ tcl-electric-brace
  351.  
  352. (defun tcl-electric-brace (arg)
  353.   "Insert `}' and indent line for tcl."
  354.   (interactive "P")
  355.   (insert-char ?} (prefix-numeric-value arg))
  356.   (tcl-indent-line)
  357.   (blink-matching-open))
  358.  
  359. ;;}}}
  360.  
  361. ;;}}}
  362. ;;{{{ searching
  363.  
  364. ;;{{{ tcl-beginning-of-proc
  365.  
  366. (defun tcl-beginning-of-proc (&optional arg)
  367.   "Move backward to the beginning of a tcl proc (or similar).
  368. With argument, do it that many times.  Negative arg -N
  369. means move forward to Nth following beginning of proc.
  370. Returns t unless search stops due to beginning or end of buffer."
  371.   (interactive "P")
  372.   (or arg
  373.       (setq arg 1))
  374.   (let ((found nil)
  375.     (ret t))
  376.     (if (and (< arg 0)
  377.          (looking-at "^[^ \t\n#][^\n]*{[ \t]*$"))
  378.     (forward-char 1))
  379.     (while (< arg 0)
  380.       (if (re-search-forward "^[^ \t\n#][^\n]*{[ \t]*$" nil t)
  381.       (setq arg (1+ arg)
  382.         found t)
  383.     (setq ret nil
  384.           arg 0)))
  385.     (if found
  386.     (beginning-of-line))
  387.     (while (> arg 0)
  388.       (if (re-search-backward "^[^ \t\n#][^\n]*{[ \t]*$" nil t)
  389.       (setq arg (1- arg))
  390.     (setq ret nil
  391.           arg 0)))
  392.     ret))
  393.  
  394. ;;}}}
  395. ;;{{{ tcl-end-of-proc
  396.  
  397. (defun tcl-end-of-proc (&optional arg)
  398.   "Move forward to next end of tcl proc (or similar).
  399. With argument, do it that many times.  Negative argument -N means move
  400. back to Nth preceding end of proc.
  401.  
  402. This function just searches for a `}' at the beginning of a line."
  403.   (interactive "P")
  404.   (or arg
  405.       (setq arg 1))
  406.   (let ((found nil)
  407.     (ret t))
  408.     (if (and (< arg 0)
  409.          (not (bolp))
  410.          (save-excursion
  411.            (beginning-of-line)
  412.            (eq (following-char) ?})))
  413.     (forward-char -1))
  414.     (while (> arg 0)
  415.       (if (re-search-forward "^}" nil t)
  416.       (setq arg (1- arg)
  417.         found t)
  418.     (setq ret nil
  419.           arg 0)))
  420.     (while (< arg 0)
  421.       (if (re-search-backward "^}" nil t)
  422.       (setq arg (1+ arg)
  423.         found t)
  424.     (setq ret nil
  425.           arg 0)))
  426.     (if found
  427.     (end-of-line))
  428.     ret))
  429.  
  430. ;;}}}
  431.  
  432. ;;}}}
  433. ;;{{{ communication with a inferior process via comint
  434.  
  435. ;;{{{ tcl-start-process
  436.  
  437. (defun tcl-start-process (name program &optional startfile &rest switches)
  438.   "Start a tcl process named NAME, running PROGRAM."
  439.   (or switches
  440.       (setq switches tcl-default-command-switches))
  441.   (setq tcl-process-buffer (apply 'make-comint name program startfile switches))
  442.   (setq tcl-process (get-buffer-process tcl-process-buffer))
  443.   (save-excursion
  444.     (set-buffer tcl-process-buffer)
  445.     (setq comint-prompt-regexp "^[^% ]*%\\( %\\)* *"))
  446.   )
  447.  
  448. ;;}}}
  449. ;;{{{ tcl-kill-process
  450.  
  451. (defun tcl-kill-process ()
  452.   "Kill tcl subprocess and its buffer."
  453.   (interactive)
  454.   (if tcl-process-buffer
  455.       (kill-buffer tcl-process-buffer)))
  456.  
  457. ;;}}}
  458. ;;{{{ tcl-set-tcl-region-start
  459.  
  460. (defun tcl-set-tcl-region-start (&optional arg)
  461.   "Set start of region for use with `tcl-send-tcl-region'."
  462.   (interactive)
  463.   (set-marker tcl-region-start (or arg (point))))
  464.  
  465. ;;}}}
  466. ;;{{{ tcl-set-tcl-region-end
  467.  
  468. (defun tcl-set-tcl-region-end (&optional arg)
  469.   "Set end of region for use with `tcl-send-tcl-region'."
  470.   (interactive)
  471.   (set-marker tcl-region-end (or arg (point))))
  472.  
  473. ;;}}}
  474. ;;{{{ send line/region/buffer to tcl-process
  475.  
  476. ;;{{{ tcl-send-current-line
  477.  
  478. (defun tcl-send-current-line ()
  479.   "Send current line to tcl subprocess, found in `tcl-process'.
  480. If `tcl-process' is nil or dead, start a new process first."
  481.   (interactive)
  482.   (let ((start (save-excursion (beginning-of-line) (point)))
  483.     (end (save-excursion (end-of-line) (point))))
  484.     (or (and tcl-process
  485.          (eq (process-status tcl-process) 'run))
  486.     (tcl-start-process tcl-default-application tcl-default-application))
  487.     (comint-simple-send tcl-process (buffer-substring start end))
  488.     (forward-line 1)
  489.     (if tcl-always-show
  490.     (display-buffer tcl-process-buffer))))
  491.  
  492. ;;}}}
  493. ;;{{{ tcl-send-region
  494.  
  495. (defun tcl-send-region (start end)
  496.   "Send region to tcl subprocess, wrapped in `eval { ... }'."
  497.   (interactive "r")
  498.   (or (and tcl-process
  499.        (comint-check-proc tcl-process-buffer))
  500.       (tcl-start-process tcl-default-application tcl-default-application))
  501.   (comint-simple-send tcl-process
  502.               (concat tcl-default-eval
  503.                   " {\n"(buffer-substring start end) "\n}"))
  504.   (if tcl-always-show
  505.       (display-buffer tcl-process-buffer)))
  506.  
  507. ;;}}}
  508. ;;{{{ tcl-send-tcl-region
  509.  
  510. (defun tcl-send-tcl-region ()
  511.   "Send preset tcl region to tcl subprocess, wrapped in `eval { ... }'."
  512.   (interactive)
  513.   (or (and tcl-region-start tcl-region-end)
  514.       (error "tcl-region not set"))
  515.   (or (and tcl-process
  516.        (comint-check-proc tcl-process-buffer))
  517.       (tcl-start-process tcl-default-application tcl-default-application))
  518.   (comint-simple-send tcl-process
  519.               (concat tcl-default-eval
  520.                   " {\n"
  521.                   (buffer-substring tcl-region-start tcl-region-end)
  522.                   "\n}"))
  523.   (if tcl-always-show
  524.       (display-buffer tcl-process-buffer)))
  525.  
  526. ;;}}}
  527. ;;{{{ tcl-send-proc
  528.  
  529. (defun tcl-send-proc ()
  530.   "Send proc around point to tcl subprocess, wrapped in `eval { ... }'."
  531.   (interactive)
  532.   (let (beg end)
  533.     (save-excursion
  534.       (tcl-beginning-of-proc)
  535.       (setq beg (point))
  536.       (tcl-end-of-proc)
  537.       (setq end (point)))
  538.     (or (and tcl-process
  539.          (comint-check-proc tcl-process-buffer))
  540.     (tcl-start-process tcl-default-application tcl-default-application))
  541.     (comint-simple-send tcl-process
  542.             (concat tcl-default-eval
  543.                 " {\n"
  544.                 (buffer-substring beg end)
  545.                 "\n}"))
  546.     (if tcl-always-show
  547.     (display-buffer tcl-process-buffer))))
  548.  
  549. ;;}}}
  550. ;;{{{ tcl-send-buffer
  551.  
  552. (defun tcl-send-buffer ()
  553.   "Send whole buffer to tcl subprocess, wrapped in `eval { ... }'."
  554.   (interactive)
  555.   (or (and tcl-process
  556.        (comint-check-proc tcl-process-buffer))
  557.       (tcl-start-process tcl-default-application tcl-default-application))
  558.   (if (buffer-modified-p)
  559.       (comint-simple-send tcl-process
  560.               (concat
  561.                tcl-default-eval
  562.                " {\n"
  563.                (buffer-substring (point-min) (point-max))
  564.                "\n}"))
  565.     (comint-simple-send tcl-process
  566.             (concat "source "
  567.                 (buffer-file-name)
  568.                 "\n")))
  569.   (if tcl-always-show
  570.       (display-buffer tcl-process-buffer)))
  571.  
  572. ;;}}}
  573.  
  574. ;;}}}
  575. ;;{{{ tcl-get-error-info
  576.  
  577. (defun tcl-get-error-info ()
  578.   "Send string `set errorInfo' to tcl subprocess and display the tcl buffer."
  579.   (interactive)
  580.   (or (and tcl-process
  581.        (comint-check-proc tcl-process-buffer))
  582.       (tcl-start-process tcl-default-application tcl-default-application))
  583.   (comint-simple-send tcl-process "set errorInfo\n")
  584.   (display-buffer tcl-process-buffer))
  585.  
  586. ;;}}}
  587. ;;{{{ tcl-restart-with-whole-file
  588.  
  589. (defun tcl-restart-with-whole-file ()
  590.   "Restart tcl subprocess and send whole file as input."
  591.   (interactive)
  592.   (tcl-kill-process)
  593.   (tcl-start-process tcl-default-application tcl-default-application)
  594.   (tcl-send-buffer))
  595.   
  596. ;;}}}  
  597. ;;{{{ tcl-show-process-buffer
  598.  
  599. (defun tcl-show-process-buffer ()
  600.   "Make sure `tcl-process-buffer' is being displayed."
  601.   (interactive)
  602.   (display-buffer tcl-process-buffer))
  603.  
  604. ;;}}}
  605. ;;{{{ tcl-hide-process-buffer
  606.  
  607. (defun tcl-hide-process-buffer ()
  608.   "Delete all windows that display `tcl-process-buffer'."
  609.   (interactive)
  610.   (delete-windows-on tcl-process-buffer))
  611.  
  612. ;;}}}
  613.  
  614. ;;}}}
  615.  
  616. ;;{{{ menu bar
  617.  
  618. (define-key tcl-mode-menu [restart-with-whole-file]
  619.   '("Restart With Whole File" .  tcl-restart-with-whole-file))
  620. (define-key tcl-mode-menu [kill-process]
  621.   '("Kill Process" . tcl-kill-process))
  622.  
  623. (define-key tcl-mode-menu [hide-process-buffer]
  624.   '("Hide Process Buffer" . tcl-hide-process-buffer))
  625. (define-key tcl-mode-menu [get-error-info]
  626.   '("Get Error Info" . tcl-get-error-info))
  627. (define-key tcl-mode-menu [show-process-buffer]
  628.   '("Show Process Buffer" . tcl-show-process-buffer))
  629.  
  630. (define-key tcl-mode-menu [end-of-proc]
  631.   '("End Of Proc" . tcl-end-of-proc))
  632. (define-key tcl-mode-menu [beginning-of-proc]
  633.   '("Beginning Of Proc" . tcl-beginning-of-proc))
  634.  
  635. (define-key tcl-mode-menu [send-tcl-region]
  636.   '("Send Tcl-Region" . tcl-send-tcl-region))
  637. (define-key tcl-mode-menu [set-tcl-regio-end]
  638.   '("Set Tcl-Region End" . tcl-set-tcl-region-end))
  639. (define-key tcl-mode-menu [set-tcl-region-start]
  640.   '("Set Tcl-Region Start" . tcl-set-tcl-region-start))
  641.  
  642. (define-key tcl-mode-menu [send-current-line]
  643.   '("Send Current Line" . tcl-send-current-line))
  644. (define-key tcl-mode-menu [send-region]
  645.   '("Send Region" . tcl-send-region))
  646. (define-key tcl-mode-menu [send-proc]
  647.   '("Send Proc" . tcl-send-proc))
  648. (define-key tcl-mode-menu [send-buffer]
  649.   '("Send Buffer" . tcl-send-buffer))
  650.  
  651. ;;}}}
  652.  
  653. (provide 'tcl-mode)
  654.  
  655.  
  656. ;;{{{ Emacs local variables
  657.  
  658. ;; Local Variables:
  659. ;; folded-file: t
  660. ;; End:
  661.  
  662. ;;}}}
  663.  
  664. ;;; tcl-mode.el ends here
  665.